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-- file Debug. Mesa 

-- last modified by Satterthwaite, July 16, 1978 11:15 AM 

DIRECTORY 

ComData: FROM "comdata" USING [bodyRoot, def initionsOnly], 

CompilerDefs: FROM "compilerdef s" USING [CloseStringTable, OpenStringTable] , 

ControlDefs: FROM "controldefs" USING [ControlLink], 

ErrorTabDefs: FROM "errortabdef s" USING [CSRptr], 

lODefs: FROM "iodefs" 

USING [CR, TAB, WriteChar. WriteDecimal . WriteOctal, WriteString], 
LitDefs: FROM "litdefs" 
USING [ 

Ittype, LitDescriptor, LitDescriptorValue, 
MasterString, StringLiteral Value], 
StringDefs: FROM "stringdefs" USING [Substring, SubStringDescriptor] . 
SymDefs: FROM "symdefs" 
USING [ 

setype, ctxtype, mdtype. bodytype, 
BitAddress, CTXRecord, TransferMode, TypeClass, 
HTIndex, SEIndex, ISEIndex, recordCSEIndex, CTXIndex, BTIndex, 
HTNull, SENull. BTNull. 
IG. IZ. typeTYPE], 
SymSegDefs: FROM "symsegdefs" USING [FindExtension], 
SymTabDefs: FROM "symtabdefs" 

USING [NextSe, SubStringForHash , TypeLink, XferMode], 
TableDefs: FROM "tabledefs" 

USING [TableBase, TableNotif ier, AddNotify, DropNotify, TableBounds], 
TreeDefs: FROM "treedefs" 
USING [ 

treetype, NodeName, TreeLink, Treelndex, TreeMap, nullTreelndex, 
UpdateTree]; 

Debug: PROGRAM 
IMPORTS 

CompilerDefs. lODefs, LitDefs, SymSegDefs, SymTabDefs, TableDefs, 
TreeDefs, 
dataPtr: ComData 
EXPORTS CompilerDefs ■ 
BEGIN 
OPEN lODefs. SymDefs; 

tb: TableDefs. TableBase; 
seb: TableDefs. TableBase; 
ctxb: TableDefs. TableBase; 
mdb: TableDefs. TableBase; 
bb: TableDefs. TableBase; 
Itb: TableDefs. TableBase; 

DebugNotify: TableDefs .TableNotif ier « 
BEGIN 

tb ♦- base[TreeDefs. treetype]; 

seb <- base[setype] ; ctxb ^ base[ctxtype]; mdb ^ base[mdtype]; 
bb ♦- base[bodytype]; 
Itb ♦- base[LitDefs. Ittype]; 
RETURN 
END; 

Substring: TYPE » StringDefs .Substring; 

-- csrP and desc.base are set by SwapInStringTab 

csrP: ErrorTabDefs. CSRptr; 

desc: StringDefs.SubStringDescriptor ; 

ss: Substring « ©desc; 

SwapInStringTab: PROCEDURE « 
BEGIN 

csrP ♦- CompilerDefs, OpenStringTable[]; 
ss.base ^ LOOPHOLE[csrP + csrP. relativebase, STRING]; 
RETURN 
END; 

WriteSubString: PROCEDURE [ss: Substring] - 
BEGIN 

i: CARDINAL; 
FOR i IN [ss. offset. .ss.offset+ss. length) 
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DO WriteChar[ss.base[i]] ENDLOOP; 
RETURN 
END; 

-- tree printing 

PrintLiteral : PROCEDURE[t: literal TreeDef s.TreeLink] ■ 
BEGIN OPEN LitDefs; 
desc: LitDescriptor; 
i: CARDINAL; 
v: WORD; 

WITH t.info SELECT FROM 
string ■> 

BEGIN WriteChar['"]; 
WriteString[StringLiteralVa1ue[ index]]; 
WriteChar['"]; 

IF index # MasterString[index] THEN WriteChar[ 'L]; ' 
END; 
word »> 
BEGIN 

desc <- Li tDescriptorValue[index]; 
IF desc. length § 1 THEN Wri teChar[ ' []; 
FOR i IN [0 .. desc. length) 
DO 

IF (v ♦- (ltb+desc.offset)[i]) < 1000 
THEN WriteDecimal[v] 
ELSE WriteOctal[v]; 
IF i+1 # desc, length THEN WriteChar[ ' , ]; 
ENDLOOP; 
IF desc. length # 1 THEN Wri teChar[ ' ]]; 
END; 
ENDCASE; 
END; 

WriteNodeName: PROCEDURE[n: TreeDef s.NodeName] « 
BEGIN 

ss. offset ^ csrP.NodePrintName[n]. offset; 
ss. length <- csrP.NodePrintName[n] .length; 
WriteSubString[ss]; RETURN 
END; 

PrintSubTree: PROCEDURE [t: TreeDef s .TreeLink. nBlanks: CARDINAL] ■ 
BEGIN OPEN TreeDefs; 

Printer: TreeMap ■ 
BEGIN 

node: Treelndex; 
Indent[nBlanks]; 
WITH s: t SELECT FROM 

hash => PrintHti[s. index]; 
symbol => PrintSei[s. index]; 
literal => PrintLiteral[s]; 
subtree »> 

BEGIN node ^ s. index; 
SELECT node FROM 

nullTreelndex »> WriteString["<empty>"L]; 
ENDCASE «> 

BEGIN OPEN (tb+node); 

WriteNodeName[name]; 

WriteChar['[]; PrintIndex[node] ; WriteString["] "L]; 

IF info if 

THEN BEGIN Wri teString[" info="L]; PrintIndex[info] END; 
IF attrl OR attr2 
THEN 
BEGIN 

IF info « THEN WriteChar[' ]; 
WriteChar['(]; 

IF attrl THEN WriteChar[ ' 1]; 
IF attr2 THEJ^ WriteChar[ '2]; 
WriteChar[')]; 
END; 
nBlanks ♦- nBlanks + 2; 
[] <- TreeDef s.UpdateTree[s, Printer]; 
nBlanks ♦- nBlanks - 2; 
END; 
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END; 
ENDCASE; 
RETURN [t] 
END; 

[] ^ Printer[t]; RETURN 
END; 

PrintTree: PUBLIC PROCEDURE [t: TreeDef s.TreeLink] - 
BEGIN 

TableDefs.AcldNotify[DebugNotify]; SwapInStringTab[]; 
PrintSubTree[t, 0]; WriteChar[CR]; 

CompilerDefs.CloseStringTable[]; TableDef s.DropNotify[DebugNotify]; RETURN 
END; 

PrintBodies: PUBLIC PROCEDURE - 
BEGIN 

bti, prev: BTIndex; 

TableDefs.AddNotify[DebugNotify]; SwapInStringTab[]; 
bti ^ dataPtr.bodyRoot; 
DO 

PrintBody[bti]; 
IF (bb+bti),firstSon » BTNull 
THEN bti ♦- (bb+bti).firstSon 
ELSE 
DO 

prev ♦- bti; bti <- (bb+bti) .1 ink. index; 
IF bti « BTNull THEN 60 TO Done; 
IF (bb+prev). link. which # parent THEN EXIT; 
ENDLOOP; 
REPEAT 

Done «> NULL; 
ENDLOOP; 
WriteChar[CR]; 

CompilerDefs.CloseStringTable[]; TableDef s.DropNotify[DebugNotify]; RETURN 
END; 

PrintBody: PROCEDURE [bti: BTIndex] » 
BEGIN 

OPEN body: (bb+bti); 

WriteChar[CR]; WriteChar[CR]; WriteString["Body: "L]; 
WITH b: body SELECT FROM 
Callable »> 
BEGIN 

PrintSei[b.id]; 

WriteString[", ep: "L]; WriteDecimal [b.entrylndex]; 
WITH b SELECT FROM 
Inner »> 
BEGIN 

WriteString[", frame address: "L]; WriteDecimal[f rameOffset]; 
END; 
ENDCASE; 
END; 
ENDCASE -> WriteString["(anon)"L]; 
WriteChar[CR]; 

WriteString[" context: "L]; PrintIndex[body . localCtx] ; 
WriteString[" , static level: "L]; WriteDecimal[body. level]; 
WITH body. info SELECT FROM 
Internal »> 
BEGIN 

WriteString[", frame size: "L]; WriteDecimal [frameSize] ; 
IF body. kind « Callable 
THEN 

BEGIN WriteChar[CR]; 

PrintSubTree[[subtree[index: bodyTree]], 0]; 
END 
ELSE 
BEGIN 

WriteString[", tree root: "L]; PrintIndex[bodyTree]; 
END; 
END; 
ENDCASE; 
WriteChar[CR]; RETURN 
END; 
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PrintSymbols: PUBLIC PROCEDURE - 
BEGIN 

ctx: CTXIndex; 

limit: CTXIndex - LOOPHOLE[TableDef s .TableBounds[SymDef s.ctxtype] .size] ; 
ctx ♦- FIRST[CTXIndex3 + SIZE [nil CTXRecord]; 
UNTIL ctx - limit 
DO 

WriteChar[CR]; PrintContext[ctx]; 
ctx ♦- ctx + (WITH (ctxb+ctx) SELECT FROM 
included »> SIZE [included CTXRecord], 
imported -> SIZE [imported CTXRecord], 
ENDCASE ■> SIZE [simple CTXRecord]); 
ENDLOOP; 
WriteChar[CR]; RETURN 
END; 

PrintContext: PROCEDURE [ctx: CTXIndex] - 
BEGIN 

sei, root: ISEIndex; 

TableDefs.AddNotify[DebugNotify]; SwapInStringTab[]; 
WriteChar[CR]; 

WriteString[ "Context: "L]; Printlndex[ctx]; 
IF (ctxb+ctx).ctxlevel tf IZ THEN 

BEGIN WriteString[". static level: "L]; 
WriteDecimal[(ctxb+ctx) .ctxlevel]; 
END; 
WITH (ctxb+ctx) SELECT FROM 
included «> 

BEGIN WriteString[". copied from [file: "L]; 
PrintHti[(mdb+ctxm.odule) .mdhti]; 
WriteString[", context: "L]; Printlndex[ctxmap]; 
WriteChar[']]; 
END; 
imported «> 

BEGIN WriteString[". imported from file: "L]; 
PrintHti[(mdb+{ctxb+includeLink) .ctxmodule) .mdhti]; 
END; 
ENDCASE; 
root ^ sei ^ (ctxb+ctx) .sel ist; 
DO 

IF sei = SENull THEN EXIT; 
PrintSEfsei 21* 

IF (sei *- SymTabDefs.NextSe[sei]) « root THEN EXIT; 
ENDLOOP; 
CompilerDefs.CloseStringTable[]; TableDef s ,DropNotify[DebugNotify]; 
RETURN 
END; 

PrintSE: PROCEDURE [sei: ISEIndex, nBlanks: CARDINAL] « 
BEGIN OPEN (seb+sei); 
typeSei: SEIndex; 
addr: BitAddress; 
link: ControlDef s.ControlLink; 
Indent[nBlanks]; 
PrintSei[sei]; 

WriteString[" ["L]; Printlndex[sei] ; WriteChar[' ]]; 
IF public THEN WriteString[" [public]"L]; 
IF mark3 
THEN 
BEGIN 

WriteString[", type » "L]; 
IF idtype « typeTYPE 
THEN 

BEGIN typeSei *- idinfo; 
WriteString["TYPE, equated to: "L]; 
PrintType[ typeSei] ; 
IF SymTabDefs.TypeLink[sei] H SENull 
THEN 

BEGIN WriteString[", tag code: "L]; WriteDecimal[idvalue] END; 
END 
ELSE 

BEGIN typeSei *- idtype; PrintType[typeSei]; 
SELECT TRUE FROM 

constant »> WriteString[" [const]"L]; 
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writeonce ■> WriteString[" [init on1y]"L]; 
ENDCASE; 
IF '-niark4 
THEN 

BEGIN WriteString[", # refs: "L]; WriteDecima1[idinfo] END 
ELSE 

SELECT TRUE FROM 
constant ■> 

IF - extended THEN 

BEGIN WriteString[". value: "L]; 
SELECT SymTabDefs.XferMode[typeSei] FROM 
procedure, program, signal, error ■> 
BEGIN link ^ idvalue; 
WriteChar['[]; 

WriteDecimalpink.gfi]; WriteChar[' ,]; 
WriteDecimal[l ink.ep]; WriteChar[' ,]; 
WriteDecimal[LOOPHOLE[link.tag]]; WriteCharC ' ]]; 
END; 
ENDCASE »> 

IF LOOPHOLE[idvalue, CARDINAL] < 1000 
THEN WriteDecimal[idvalue] 
ELSE WriteOctal[ idvalue]; 
END; 
(dataPtr.def initionsOnly AND (ctxb+ctxnum) .ctxlevel ■ IG) »> 
BEGIN WriteString[", index: "L]; WriteDecimal [idvalue] END; 
ENDCASE -> 

BEGIN addr ^ idvalue; 
WriteStringC", address: "L]; 
WriteDecimal[addr.wd]; WriteChar[' ]; 
WriteChar[ ' []; WriteDecimal[addr.bd]; 
WriteChar[ ' :]; Wri teDecimal[idinfo]; 
WriteChar[']]; 

IF linkSpace THEN WriteChar[ ' ♦]; 
END; 
END; 
PrintTypeInfo[typeSei , nBlanks+2]; 
IF extended 

THEN PrintSubTree[SymSegDef s.FindExtension[sei], nBlanks+4]; 
END; 
RETURN 
END; 

PrintHti: PROCEDURE [hti: HTIndex] » 
BEGIN 

desc: StringDef s .SubStringDescriptor ; 
s: Substring « @desc; 
IF hti = HTNull 

THEN WriteString["(anon)"L] 

ELSE 

BEGIN SymTabDefs.SubStringForHash[s, hti]; WriteSubString[s] END; 
RETURN 
END; 

PrintSei: PROCEDURE [sei: ISEIndex] « 
BEGIN 

PrintHti[IF sei=SENull THEN HTNull ELSE (seb+sei ) .htptr]; 
RETURN 
END; 

WriteTypeName: PROCEDURE [n: TypeClass] ■ 
BEGIN 

ss. offset ^ csrP.TypePrintName[n] .of f set; 
ss. length <~ csrP.TypePrintName[n]. length; 
WriteSubString[ss]; RETURN 
END; 

WriteModeName: PROCEDURE [n: TransferMode] « 
BEGIN 

ss. offset <- csrP.ModePrintName[n].of f set; 
ss. length ♦- csrP.ModePrintName[n]. length; 
WriteSubString[ss]; RETURN 
END; 



PrintType: PROCEDURE [sei: SEIndex] 
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BEGIN 

tSei: SEIndex; 
IF sei ■ SENull 
THEN WriteCharC'?] 
ELSE 

WITH t: (seb+sei) SELECT FROM 
constructor ■> 

WITH t SELECT FROM 

transfer ■> WriteModeName[mode]; 
ENDCASE ■> WriteTypeName[t.typetag]; 
id ■> 
BEGIN 

PrintSei[LOOPHOLE[sei, ISEIndex]]; tSei ^ sei; 
UNTIL (tSei *- SymTabDef s .TypeLink[tSei]) ■ SENull 
DO 

WITH (seb+tSei) SELECT FROM 
id ■> 

BEGIN WriteChar[' ]; PrintSei[LOOPHOLE[tSei , ISEIndex]]; 
END; 
ENDCASE; 
ENDLOOP; 
END; 
ENDCASE; 
WriteString[" ["L]; Printlndex[sei]; WriteChar[ ' ]]; 
RETURN 
END; 

PrintTypelnfo: PROCEDURE [sei: SEIndex. nBlanks: CARDINAL] - 
BEGIN 

IF sei # SENull 
THEN 

WITH s: (seb+sei) SELECT FROM 
constructor •> 

BEGIN Indent[nB1anks]; 

WriteChar['[]; Printlndex[sei]; WriteString["] "L]; 

WITH s SELECT FROM 

transfer ■> WriteModeName[mode]; 
ENDCASE »> WriteTypeName[s. typetag]; 
WITH t: s SELECT FROM 
basic »> 

BEGIN WriteString[". length: "L]; WriteDecimal[t. length] END; 
enumerated ■> 
BEGIN 

IF t. ordered THEN WriteString[" (ordered)"L]; 
WriteString[", value ctx: "L]; 
Printlndex[t.valuectx]; 
END; 
record «•> 
BEGIN 

IF --t.lengthUsed THEN WriteChar[ ' *]; 
IF t.machineDep THEN WriteString[" (md)"L]; 
IF t. monitored THEN WriteString[" (monitored)"L]; 
IF t. variant THEN WriteString[" (variant)"L]; 
OutRecordCtx[", field ctx: "L. LOOPHOLE[sei , recordCSEIndex]] ; 
WITH (ctxb+t.fieldctx) SELECT FROM 
included »> 

IF '-ctxcomplete THEN WriteString[" [partial ]"L]; 
imported ■»> WriteString[" [partial]"L]; 
ENDCASE; 
WITH t SELECT FROM 
linked "> 

BEGIN WriteString[\ link: "L]; 
PrintType[l ink type]; 
END; 
ENDCASE; 
END; 
pointer ■> 
BEGIN 

IF ~t. dereferenced THEN Wri teChar['*]; 
IF t. ordered THEN WriteString[" (ordered)"L]; 
IF t. basing THEN WriteStringf" (base)"L]; 
WriteString[", pointing to: "L]; 
PrintType[t. pointed to type]; 
PrintTypeInfo[t . pointed to type, nBlanks+2]; 
END; 
array »> 
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BEGIN 

IF -t.lengthUsed THEN WriteChar[ ' *]; 
IF t. packed THEN WriteString[" (packed)"L]; 
WriteString[", index type: "L]; PrintType[t . indextype] ; 
WriteString[", component type: "L]; PrintType[t.componenttype]; 
PrintTypeInfo[t. indextype, nBlanks+2]; 
Pr i n tTy pe I nfo[t. component type, nBlanks+2]; 
END; 
arraydesc ■> 
BEGIN 

WriteString[", described type: "L]; PrintType[t.describedType]; 
PrintTypeInfo[t.describedType, nBlanks+2]; 
END; 
transfer »> 
BEGIN 

OutRecordCtx[" , input ctx: "L, t.inrecord]; 
OutRecordCtx[", output ctx: "L, t .outrecord]; 
END; 
definition ■> 
BEGIN 

WriteString[", ctx: "L]; Printlndex[t .defCtx]; 
WriteString[", ngfi: "L]; WriteDecima1[t.nGf i]; 
END; 
union ■> 
BEGIN 

IF t.overlayed THEN WriteString[" {over1ayed)"L]; 
IF t. controlled 

THEN BEGIN WriteString[" , tag: "L]; PrintSei[t . tagsei] END; 
WriteString[", tag type: "L]; 
Pr i n tTy pe[(seb+t. tagsei) .idtype]; 

WriteString[". case ctx: "L]; Printlndex[t.casectx]; 
IF t. controlled 

THEN PrintSE[t. tagsei, nBlanks+2]; 
END; 
relative »> 
BEGIN 

WriteString[" , base type: "L]; PrintType[t .baseType]; 
WriteString[", offset type: "L]; PrintType[t.off setType]; 
WriteString[", result type: "L]; PrintType[t. resul tType]; 
Pr i n tTy pe I nfo[t. baseType, nBlanks+2]; 
Pr i n tType I nf oft. off setType, nBlanks+2]; 
Pr i n tTy pe I nfo[t. resul tType, nBlanks+2]; 
END; 
subrange »> 
BEGIN 

WriteString[" of: "L]; PrintType[t . rangetype]; . 
IF t. filled 
THEN 
BEGIN 

WriteString[" origin: "L]; WriteDecimal [t. origin] ; 
WriteString[" , range: "L]; 
IF t. flexible 

THEN WriteChar['*] 
ELSE WriteDecimal[t. range]; 
END; 
Pr i n tType I nfo[t. rangetype, nBlanks+2]; 
END; 
long, real ■> 
BEGIN 

WriteString[" of: "L]; PrintType[t. rangetype]; 
Pr i n tType I nfo[t. rangetype, nBlanks+2]; 
END; 
ENDCASE; 
END; 
ENDCASE; 
RETURN 
END; 

OutRecordCtx: PROCEDURE [message: STRING, sei: recordCSEIndex] - 
BEGIN 

WriteString[message]; 
IF sei - SENull 

THEN WriteString["NIL"L] 

ELSE Prin tlndex[(seb+sei) .f ieldctx]; 
RETURN 
END; 
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Printlndex: PROCEDURE [v: UNSPECIFIED] - L00PH0LE[WriteDecima1] ; 

Indent: PROCEDURE [n: CARDINAL] ■ 
BEGIN 

WriteChar[CR]: 

THROUGH [l..n/8] DO WriteChar[TAB] ENDLOOP; 
THROUGH [L.n MOD 8] DO WriteChar[' ] ENDLOOP; 
RETURN 
END; 

END. 



